COMMENT ⊗   VALID 00022 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	 MacLisp portion of the E/MacLisp Interface.
C00010 00003	 αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
C00019 00004	(lap em:MAIL-interface subr)
C00023 00005	(entry em:mail-type subr)
C00028 00006	(entry em:wait-mail subr)
C00030 00007	(entry em:mail-sfa subr)
C00033 00008	 TYI
C00036 00009	 TYO
C00038 00010	 FORCE OUTPUT
C00041 00011	 Routine to get to a buffer from E with not all <cr>s in it
C00042 00012	 This routine gets fresh mail to initialize the reader
C00047 00013	 This routine does a jobread into the right spot.
C00049 00014	wait-ok  
C00050 00015	(entry em:send-simple-message subr)
C00053 00016	(entry em:send-control-char subr)
C00055 00017	(entry em:init subr)
C00056 00018	send-ok
C00057 00019	(entry em:eval-protect subr)
C00058 00020	 Routines for obtaining the values of readonly variables
C00062 00021	 debugging routines
C00063 00022	 Storage for Mail routines
C00066 ENDMK
C⊗;
;;; MacLisp portion of the E/MacLisp Interface.
;;;
;;; An SFA/MAIL based system for communicating with
;;; an unstructured, standard text editor.
;;; Starts with -em:jobnum- figured out from E.
;;; (sfa-call <sfa> 'send-lines n)
;;; sets the number of lines that are sent at one time to n.
;;; normal is T (meaning send every line).
;;; NIL means never send.
;;; (sfa-call <sfa> 'report-send-lines) returns the value
;;; (ecalledp) defined in (HELP) tells whether E called you

(declare (mapex t)
         (setq defmacro-for-compiling ())
	 (special -em:jobnum- -em:e-commands- -em:sfa- -em:errorp- 
		  -em:mail-input-buffer-dry-handler-
		  -em:filemode- grlinel)
	 (*lexpr em:fread)
	 (fixnum -em:jobnum-))

(setq -em:e-commands- ()
      -em:mail-input-buffer-dry-handler- ()
      -em:filemode- ()
      grlinel (linel t))

(setq -em:sfa- ())

(sstatus ttyint 232. '+internal-↑B-break)
(sstatus ttyint 200. '+internal-↑B-break)

(defun em:initialize ()
       (em:get-jobnum)
       (em:init)
       (em:init-send-lines)
       (em:send-simple-message 'ok -em:jobnum-)
       (setq -em:sfa- (sfa-create (function em:mail-sfa) 0 'mail-sfa))
       (setq tyi -em:sfa-)
       (setq tyo -em:sfa-)
;      (sfa-store -em:sfa- 'xcons -em:sfa-)
       t)
 
(defmacro unascii (x)
 `(car (exploden ,x)))

(defun em:ecommands (l)
       (let ((-em:e-commands- t))
	    (do ((com l (cdr com)))
		((null com)(sfa-call -em:sfa- 'force-output ()))
		(cond ((eq (car com) '<cr>)
		       (sfa-call -em:sfa- 'tyo '(⊗ ↔)))
		      ((eq (car com) '<lf>) 
		       (sfa-call -em:sfa- 'tyo '(⊗ ↓)))
		      (t 
		       (sfa-call -em:sfa- 'tyo
				 (unascii (car com))))))))

(defun em:set-send-lines (n)
 (sfa-call -em:sfa- 'send-lines n))

(defun em:get-send-lines ()
 (sfa-call -em:sfa- 'report-send-lines ()))

(defun em:force ()
 (sfa-call -em:sfa- 'force-output ()))

(defun em:terpri () (terpri -em:sfa-))

;(setq read-eval-print-* 'em:terpri)

(defun em:eval-until-eof ()
 ((lambda (eof)
  (em:file-align)(em:set-send-lines t)
  (do ((form (em:fread eof) (em:fread eof))
       (l nil)) 
      ((eq form eof)
       (do ((i (nreverse l) (cdr i))) 
	   ((null i)
	    (sfa-call -em:sfa- 'force-output ())
	    (em:set-send-lines ()))
	   (print (car i))))
   (setq l (cons (eval form) l)))) (ncons ())))

(defun em:fread n
 ((lambda (-em:filemode-)
	  (cond ((zerop n)
		 (read))
		((= n 1)
		 (read (arg 1)))
		((= n 2)
		 (read (arg 1)(arg 2)))
		(t 
		 (error '|too many args to FREAD|))))
  t))

(defun em:control-dispatch (char)
 (cond ((member char '(#o302 #o342))
	(funcall '+internal-↑B-break -em:sfa- char))
       ((member char '(#o303 #o343))
	(setq ↑D ()))
       ((member char '(#o304 #o344))
	(setq ↑D t))
       (t ((lambda (fun)
		   (cond (fun (funcall fun -em:sfa- char))))
	   (status ttyint char)))))

(defun em:readonly-vars (l)
       ;make up message and initial (sixbit . ascii) alist
       (cond ((> (length l) #o1000)
	      (error '|too many read only variables requested|)))
       (setq l
	     (mapcar #'(lambda (x)
			       (subst () ()
				      `(,(em:make-sixbit x)
					,x () ())))
		     l))
       (em:force-readonly-message)
       (do ((nxt (em:get-next-readonly)
		 (em:get-next-readonly))
	    (entry))
	   ((equal nxt -1)
	    (mapcan #'(lambda (x)
			      (cond 
			       ((caddr x) 
				`((,(cadr x),(cadddr x))))))
		    l))
	   (cond ((setq entry (assoc (car nxt) l))
		  (rplaca (cdddr entry) (cdr nxt))
		  (rplaca (cddr entry) t)))))

(defun em:send-next-line ()
 (let ((alist (em:readonly-vars '(line lines page pages))))
      (let ((line (cdr (assq 'line alist)))
	    (lines (cdr (assq 'lines alist)))
	    (page (cdr (assq 'page alist)))
	    (pages (cdr (assq 'pages alist))))
	   (cond ((= lines line)
		  (cond ((= page pages)
			 (error '|No right paren found|))
			(t (em:ecommands 
			    '(α p α =)))))
		 (t (em:ecommands '(⊗ ↔ α =)))))))

(defun em:eval-sexp ()
 (let ((-em:mail-input-buffer-dry-handler- 'em:send-next-line))
      (print (eval (read)))))

;;; αxSLISP dsk:maclsp.dmp[1,3](elisp.ini)
;;; αnαxSLISP talks to job n(10.)
;;; α0αxSLISP types the wholine of inferior
;;; α-αxSLISP murder (i.e. negotiated suicide)
;;; α=	send arrow line or attach buffer
;;; α+nα=	send next n lines
;;; α-nα=	send previous n lines
;;; αx= <sexp>
;;; 	send comand line
;;; 
;;; Protocols: (* means not actually anticipated to be used; current
;;; implementation knows about it but does not send and/or interpret them
;;; specially)
;;; 
;;; From E to MacLisp
;;; 	Mail
;;; 	wd0:	Job# sending message
;;; 	wd1:	type of message
;;; 
;;; 2,,0:   Continuation needed
;;; 1,,0:	Short (fits in the next =30 words, ends with null byte
;;;         or falls off)
;;; 
;;; 0		no-op
;;; 1		initiating a conversation
;;; 2		ok (did the jobread)
;;; 3		SEXPs
;;; 4		explicit eof
;;; 5		control (meta) chars to follow (E macro format)
;;; 		 (or E commands (from MacLisp to E))
;;; 6		interrupt. do <esc>i <char>
;;; 7		close connection (suicide)
;;; 
;;; 	wd2:	-number of bytes,,address of buffer
;;; 		
;;; 
;;; E commands will be represented in the standard E macro manner
;;; (unless there is something better).
;;; 
;;; 
;;; Protocol is:
;;; 	E	MacLisp
;;;         ---------------
;;; 	initiate
;;; 		ok
;;; 
;;; To send a short message just a MAIL
;;; To send a long message MAIL then wait for JOBREAD acknowledge
;;; To send interrupts, just send them
;;; Acknowledgment is the short OK message
;;; 
;;; Commands needed:
;;; 	start DMP file
;;; 	send control chars
;;; 	send interrupt character (just 1 at a time)
;;; 
(lap em:MAIL-interface subr)

	(defsym mlblksize 32.)
	(defsym freeac #o13)
	(defsym cntrl-bit #o200)
	(defsym meta-bit #o400)
	(defsym ccntrlg #o307)
	(defsym cntrlg #o347)
	(defsym ccntrlx #o330)
	(defsym cntrlx #o370)
	(defsym EPR #o456062)
	(defsym noutbytes #o10000)
	(defsym nrovbytes #o1000)
	(defsym rdblk #o2000)
	(defsym blksize #o2000)
	(defsym maxshort 145.)
	(defsym rovmaxshort 15.)

	(defsym lf #o12)
	(defsym cr #o15)
	(defsym noop-type 0)
	(defsym initiate-type 1)
	(defsym ok-type 2)
	(defsym sexp-type 3)
	(defsym explicit-eof-type 4)
	(defsym ecommand-type 5)
	(defsym interrupt-type 6)
	(defsym kill-type 7)
	(defsym readonlyvar-type 8.)
	(defsym high-command 8.)

	(defsym space #o40)
	(defsym tab #o11)
	(defsym alpha 2)
	(defsym beta 3)
	(defsym cont-bit 2)
	(defsym short-bit 1)
	(defsym meta-mask 400)
	(defsym control-mask 200)

em:process-mail
;	(skipge 0 mailinp)		;-1 means mail in and not read
;	(jrst 0 gm2)
;	(skipn 0 (special sail-mail-interrupt))
;	(mail 2 mailbox)		;SRCV
;	(jfcl)
gm2;	(setzm 0 mailinp)
	(setzm 0 tyi-inited)
	(setzm 0 (special sail-mail-interrupt))
 	(hlrz tt mailbox)		;get EPR half
 	(caie tt epr)			;is it EPR (in sixbit)?
 	(jrst 0 wrongj)
	(hrrz tt mailbox)		;get the jobnum
	(skipg 0 jobnum)
	(jrst 0 gm1)
	(came tt jobnum)		;correct one?
	(jrst 0 wrongj)
gm3	(movem tt jobread)
   	(move tt (+ mailbox 1))		;type bits
	(jrst 0 em:mail-type)

;;; Silly jobnum was never set

gm1	(movem tt jobnum)
	(movem tt jobn2)
	(jsp t fxcons)			;number cons
	(movem a (special -em:jobnum-)) ;save it
	(jrst 0 gm3)

true	(movei a 't)
	(popj p)
false	(movei a 'nil)
	(popj p)

(entry em:get-jobnum subr)
(args em:get-jobnum (nil . 0))
	(move tt (special sail-mail-interrupt))
	(movem tt jobnum)
	(movem tt jobn2)
	(jsp t fxcons)			;find that entry!
	(movem a (special -em:jobnum-))
	(setzm 0 (special sail-mail-interrupt))
	(popj p)

(entry em:set-jobnum subr)
(args em:set-jobnum (nil . 1))
	(move tt 0 a)
	(movem a (special -em:jobnum-))
	(movem tt jobnum)
	(movem tt jobn2)
	(popj p)
wrongj 	(movei a 'wrong-jobnum)
	(popj p)
(entry em:mail-type subr)
(args em:mail-type (nil . 0))

em:mail-type
	(setzm 0 explicit-eof)	;0 means nil
	(setzm 0 forcedp)
	(move tt (+ mailbox 1));type bits
	(movei a 'nil)		;short flag
	(tlne tt short-bit)
	(movei a 't)
	(movem a (special -em:shortp-))
	(movei a 'nil)
	(tlne tt cont-bit)
	(movei a 't)
	(movem a (special -em:contp-))
	(hrrzs 0 tt)		;grumble, test for range
	(skipge 0 tt)		;too low?
	 (jrst 0 unknown)	;yup, unknown
	(caile tt high-command) ;too high
	 (jrst 0 unknown)
	(xct 0 type-disp tt)	;dispatch
unknown (movei a 'unknown)
	(popj p)
type-disp
	(jrst 0 no-op)
	(jrst 0 initiate)
	(jrst 0 ok)
	(jrst 0 sexps)
	(jrst 0 explicit-eof)
	(jrst 0 e-command)
	(jrst 0 interrupt)
	(jrst 0 kill)
	(jrst 0 readonlyvars)

e-command 
	(movei a 'ecommand)
	(popj p)
no-op
	(movei a 'no-op)
	(popj p)
sexps	
	(setzm 0 eofp)		;within eof
	(skipge 0 inbytes)
	(jrst 0 snot-finished)
sresume	(move a (+ mailbox 2))	;get number of bytes
	(move tt (+ mailbox 1))	;type bits
	(setzm 0 tyi-inited)	;tyi not inited
	(hlrem a inbytes)	;store it
	(hlre b a)		;-number of bytes
	(idivi b 4)		;-number of words
	(jumpe c ztesch)
	(subi b 1)		;one more, bunkie
ztesch	
	(movem b inwords)
	(setom 0 mailprocessed)
	(tlne tt short-bit)	;short?
	(jrst 0 tshort)
	(pushj p transfer-buffer)
	(movei a 'sexps)
	(popj p)
tshort	(pushj p transfer-short)
	(movei a 'sexps)
	(popj p)
initiate(movei a 'initiate)
	(setom 0 mailprocessed)
	(popj p)
readonlyvars
	(move a (+ mailbox 2))	;number of bytes
	(hlrem a rinbytes)
	(move a irovpointtem)
	(movem a irovpoint)
	(setom 0 mailprocessed)
	(movem b inwords)
	(setom 0 mailprocessed)
	(move tt (+ mailbox 1))	;type bits
	(tlne tt short-bit)	;short?
	(jrst 0 rtshort)
	(pushj p transfer-buffer)
	(movei a 'readonlyvars)
	(popj p)
rtshort	(pushj p transfer-short)
	(movei a 'sexps)
	(movei a 'readonlyvars)
interrupt
	(movei a 'interrupt)
	(setzm 0 mailprocessed)
	(popj p)
explicit-eof
	(setom 0 explicit-eof)
	(movei a 'eof)
	(popj p)
ok
	(movei a 'ok)
	(setzm 0 mailprocessed)
	(popj p)

kill	(pushj p send-ok)
	(calli 1 12)	;kill self

snot-finished
	(setzm 0 tyi-inited)
	(movei a sresume)
	(movem a resume-pc)
	(movei a 'sexps)
	(popj p)

(entry em:wait-mail subr)
(args em:wait-mail (nil . 0))

em:wait-mail
	(skipe 0 tyop)
 	(pushj p force2)
	(skipe 0 (special sail-mail-interrupt))
 	(jrst 0 wm2)
	(skipn 1 (special -em:mail-input-buffer-dry-handler-))
	(jrst 0 wm1)
	(pushj p em:call-handler)
wm1	(722←33 0 mailint)	;imskcl
	(mail 1 mailbox)	;WRCV
 	(721←33 0 mailint)	;imskst
wm2	(setzm 0 (special sail-mail-interrupt))
	(setom 0 mailprocessed)	;mail now in
;	(setom 0 mailinp)	;got mail
      	(movei a 't)
	(popj p)

(entry em:mask-off subr)
(args em:mask-off (nil . 0))
	(722←33 0 mailint)	;imskcl
	(movei a 't)
	(popj p)

(entry em:mask-on subr)
(args em:mask-on (nil . 0))
	(721←33 0 mailint)	;imskst
	(movei a 't)
	(popj p)

em:call-handler
	(movem freeac (+ svdacs 9.))
	(movei freeac svdacs)
	(hrli freeac b)
	(blt freeac (+ svdacs 9.))
	(setz b)
	(movei freeac c)
	(hrli freeac b)
	(blt freeac freeac)
	(callf 0 0 1)
	(hrlzi freeac svdacs)
	(hrri freeac b)
	(blt freeac freeac)
	(popj p)
(entry em:mail-sfa subr)
(args em:mail-sfa (nil . 3))
	(movei a 0 b)	;operation type ignore the object
	(caie a 'which-operations)
	(jrst 0 t1)
	(movei a '(tyi tyo terpri force-output untyi charpos linel
		       force-readonly-message send-lines report-send-lines))
	(popj p)
t1	(cain a 'tyi)		;tyi?
	(jrst 0 em:mail-tyi)
	(cain a 'tyo)		;tyo?
	(jrst 0 em:mail-tyo)
	(cain a 'terpri)
	(jrst 0 em:terpri)
	(cain a 'force-output)	;force output?
	(jrst 0 em:mail-force-output)
	(cain a 'untyi)		;untyi?
	(jrst 0 em:mail-untyi)
	(cain a 'charpos)
	(jrst 0 em:mail-charpos)
	(cain a 'linel)
	(jrst 0 em:mail-linel)
	(cain a 'send-lines)
	(jrst 0 isend-lines)
	(cain a 'report-send-lines)
	(jrst 0 report-send-lines)
	(cain a 'force-readonly-message)
	(jrst 0 em:force-readonly-message)
	(movei a 'nil)
	(popj p)

(entry em:mail-charpos subr)
(args em:mail-charpos (nil . 0))
em:mail-charpos
	(move tt charpos)
	(jrst 0 fix1)

em:mail-linel
	(movei t g1) 
	(push p t) 
	(push p (% 0 0 't)) 
	(movni t 1) 
	(jcall 16 'linel) 
g1	(popj p) 

isend-lines
	(movem c send-lines)
	(move c @ c)
	(movem c skipp)
	(movem c vsend-lines)
	(movei a 't)
	(popj p)

report-send-lines
	(move a send-lines)
	(popj p)

(entry em:init-send-lines subr)
(args em:init-send-lines (nil . 0))
	(movei a (+ noutbytes 1))
	(movem a outbytes)
	(movei a (+ nrovbytes 1))
	(movem a rovbytes)
	(movei tt 0)
	(movem tt vsend-lines)
	(movem tt skipp)
	(movei a 'NIL)
	(movem a send-lines)
	(popj p)

em:terpri
	(setzm 0 )
	(setzm 0 forcedp)
	(setom 0 tyop)
	(movei a cr)
	(pushj p tyo1)
	(movei a lf)
	(jrst 0 tyo1)
;;; TYI

(entry em:mail-tyi subr)
em:mail-tyi
	(skipe 0 explicit-eof)
	(jrst 0 eeof)
	(movem c eofchar)
	(skipe 0 untyif)
	(jrst 0 untyi2)
	(skipn 0 tyi-inited)	;not inited?
	(pushj p real-mail-refresh)
ityi	(skipe 0 inbytes)	;and nothing left?
	 (jrst 0 tyi1)
	(skipe 0 (special -em:contp-))	;a continuation?
	 (jrst 0 tyi2)
  	(skipe 0 (special -em:filemode-))	;in special file mode?
	 (jrst 0 reof)
tyi2	(pushj p mail-refresh)
tyi1	(aosle 0 inbytes)
	(pushj p mail-refresh)
inmailok
	(ildb tt inpoint)	;get byte
	(trne tt cntrl-bit)
	 (jrst 0 pondercntrl)
	(jrst 0 fix1)		;what a bum!
	(pushj p mail-refresh)
	(jrst 0 tyi1)

em:mail-untyi
	(aos 0 untyif)
	(move b untyipdl)
	(push b c)
	(movem b untyipdl)
	(popj p)

untyi2	(move b untyipdl)
	(sosl 0 untyif)
	(pop b a)
	(movem b untyipdl)
	(popj p)
	
eeof	(setzm 0 explicit-eof)

reof
	(setom 0 eofp)
	(move a eofchar)
	(sub p (% 0 0 1 1))
	(popj p)
pondercntrl
	(trnn tt meta-bit)	;foo it was control-meta
	 (jrst 0 tyi3)
	(jrst 0 fix1)		;what a bum!
tyi3	(caie tt ccntrlg)	;↑G
	(cain tt cntrlg)		;↑g
	 (call 0 '↑G)
	(caie tt ccntrlx)	;↑X
	(cain tt cntrlx)		;↑x
	 (jrst 0 ↑Xhandler)
	(movei tt 0 tt)
	(jsp t fxcons)
	(call 1 'em:control-dispatch)
	(jrst 0 em:mail-tyi)
↑Xhandler
	(movei t em:mail-tyi)
	(push p t) 
	(push p (% 0 0 'quit)) 
	(movni t 1) 
	(jcall 16 'error) 
;;; TYO

(entry em:mail-tyo subr)
em:mail-tyo
	(setzm 0 forcedp)
	(setom 0 tyop)
	(move a @ c)

	(caie a cr)
 	(cain a lf)
	(skipa)
 	(setom 0 noncrlf)	;means a non crlf char has been sent

tyo1	(aos 0 charpos)
	(idpb a outpoint)	;put it there
	(sosg 0 outbytes)	;ready to send?
	(pushj p cmail-sendit)
	(caie a lf)
	(jrst 0 true)
forceit
	(skipn 0 noncrlf)
	 (jrst 0 true)		;only crlf's so far
	(skipn 0 send-lines)	;if NIL then just return
	(jrst 0 force1)
	(movei tt 't)
	(camn tt send-lines)
	(jrst 0 true)
	(sosle 0 skipp)		;ready to do it?
	(jrst 0 true)
force1	(pushj p fmail-sendit)
	(movei a 't)
	(popj p)

;;; special entry for Refresh case only

force2	(skipn 0 send-lines)	;if NIL then just return
	(jrst 0 force1)
	(popj p)

;pondercr
;	(skipn 0 firstyo)
;	(jrst 0 tyo1)
;	(jrst 0 true)
;ponderlf
;	(skipn 0 firstyo)
;	(jrst 0 tyo1)
;	(setzm 0 firstyo)
;	(jrst 0 true)

;;; FORCE OUTPUT

fmail-sendit
	(setom 0 forcedp)
	(setz b)
	(jrst 0 mail-sendit)
cmail-sendit
	(movei tt cont-bit)
	(jrst 0 mail-sendit)

em:mail-force-output
(entry em:mail-force-output subr)
	(skipe 0 forcedp)
	(jrst 0 true)
	(setz b)		;continuation
mail-sendit
;	(setom 0 firstyo)
	(setzm 0 noncrlf)
	(setzm 0 charpos)
	(setzm 0 tyop)
	(move a vsend-lines)
	(movem a skipp)

;	(movei a 40)		;space
;	(aos 0 charpos)
;	(idpb a outpoint)
;	(sos 0 outbytes)	;extra byte

	(movei a outmail)	;address of buffer
	(movem a (+ mailbox 2))
	(move a outbytes)	
	(movei a (+ noutbytes 1))
	(sub a outbytes)	
	(movei t 1)		;1 in t means long
	(caile a maxshort)		;short enough
	(jrst 0 send-message)	;nope
	(setz t)		;0 in T means short
	(hrlzi tt outmail)
	(hrri  tt (+ mailbox 3))
	(blt tt (+ mailbox (- mlblksize 1)))	;move to the right place
	(iori b short-bit)
send-message
	(hrl tt b)		;swap
	(hrri tt sexp-type)
	(skipe 0 (special -em:e-commands-))
	(hrri tt ecommand-type)
	(movem tt (+ mailbox 1))
	(movns 0 a)
	(hrlzm a (+ mailbox 2))
	(movei a outmail)
	(hrrm a (+ mailbox 2))
	(move a thisjob)
 	(hrli a epr)		;epr validation
	(movem a mailbox)
	(mail 5 jobnum)		;mail it
	(jsp tt wait-for-clear)
	(skipa)
	(jrst 0 wrongj)
	(skipe 0 (special sail-mail-interrupt))
	(jrst 0 sm1)
	(hrlzi a mailbox)
	(hrri a (+ mailbox 1))
	(setzm 0 mailbox)
	(blt a (+ mailbox (- mlblksize 1)))	;zero it
sm1	(move a outpointtem)	;setup output byte count
	(movem a outpoint)
	(movei a (+ noutbytes 1))
	(movem a outbytes)
	(jumpe t sm2)		;don't hang around
	(pushj p wait-ok)	;wait for acknowledgment
	(pushj p em:mail-type)
	(came a 'ok)
	(jrst 0 false)
sm2	(hrlzi a outmail)
	(hrri a (+ outmail 1))
	(setzm 0 outmail)
	(blt a (+ outmail (- rdblk 1)))	;zero it
	(jrst 0 true)

;;; Routine to get to a buffer from E with not all <cr>s in it

(entry em:file-align subr)
(args em:file-align (nil . 0))
em:file-align
	(move tt inpoint)	;copy of byte pointer
	(move t inbytes)
filalgn2
	(aosle 0 t)
	(pushj p filalgn1)
	(ildb a tt)
	(skipn 0 a)
	 (jrst 0 alnxtx)
	(caie a tab)
	(cain a space)
	 (jrst 0 alnxtx)
	(caie a cr)	;a cr?
	(cain a lf)	;a lf?
	(skipa)
	(jrst 0 true)

alnxtx	(ibp 0 inpoint)
	(aos 0 inbytes)
	(jrst 0 filalgn2)
filalgn1
	(pushj p mail-refresh)
	(move tt inpoint)
	(move t inbytes)
	(popj p)
;;; This routine gets fresh mail to initialize the reader
mail-refresh
real-mail-refresh
	(skipn 0 (special sail-mail-interrupt))
	 (jrst 0 mr2)
;	(setom 0 mailinp)
	(setom 0 mailprocessed)
   	(setzm 0 (special sail-mail-interrupt))
	(jrst 0 em:process-mail)
    	(setzm 0 (special sail-mail-interrupt))
mr2	(skipn 0 mailprocessed)	;processed?
	(jrst 0 mr1)		;get the next batch
mr3	(pushj p em:wait-mail)	;wait for response
	(jrst 0 em:process-mail)	;get the mail

mr1	(skipn 0 resume-pc)	;ready for crock?
	(jrst 0 mr3)		;nope
    	(pushj p @ resume-pc)	;get the rest
	(popj p)		;continue

;;; This routine does a jobread into the right spot.

transfer-buffer
	(move a inpointtem)	;byte pointer template
	(movem a inpoint)
	(setom 0 tyi-inited)	;ready to read
	(movei tt jobread)
	(pushj p zinmail)
	(move a (+ mailbox 2))
	(hrl a inwords)
	(movem a (+ jobread 1))
	(calli tt 400050)	;jobrd
	(jrst 0 false)
	(jrst 0 send-ok)
	(popj p)		;good return

zinmail
	(hrlzi a inmail)
	(hrri a (+ inmail 1))
	(setzm 0 inmail)
	(blt a (+ inmail (- rdblk 1)))
	(popj p)

(entry em:clear-input subr)
(args em:clear-input (nil . 0))
	(setzm 0 tyop)
;	(setzm 0 firstyo)
	(setzm 0 forcedp)
	(setzm 0 noncrlf)
	(setzm 0 untyif)
	(setzm 0 inbytes)
	(setzm 0 rinbytes)
	(move a temuntyipdl)
	(movem a untyipdl)
	(setom 0 explicit-eof)
	(setom 0 eofp)
;	(setzm 0 mailinp)
	(setom 0 mailprocessed)
	(setzm 0 tyi-inited)
	(pushj p zinmail)
	(movei a 't)
	(popj p)
wait-ok  
 	(722←33 0 mailint)	; mskcl
	(skipn 0 (special sail-mail-interrupt))
	(mail 1 mailbox)	;WRCV
 	(721←33 0 mailint)	;imskst
	(move tt (+ mailbox 2))
	(setzm 0 (special sail-mail-interrupt))
;	(setzm 0 mailinp)
	(hrrzs tt)		;flush short?
	(caie tt ok-type)
	(jrst 0 true)
	(jrst 0 false)
(entry em:send-simple-message subr)
(args em:send-simple-message (nil . 2))

	(cain a 'initiate)
	(jrst 0 initiate-message)
	(cain a 'ok)
	(jrst 0 ok-message)
	(cain a 'hold-it)
	(jrst 0 hold-it-message)
	(cain a 'eof)
	(jrst 0 eof-message)
	(movei a 'Invalid-message)
	(popj p)

eof-message
	(movei a explicit-eof-type)
	(jrst 0 send-simple-message)
initiate-message
	(movei a initiate-type)
	(jrst 0 send-simple-message)
ok-message
	(movei a ok-type)
	(jrst 0 send-simple-message)
hold-it-message
	(movei a 102)
	(movem a (+ mailb2 2))
	(movei a interrupt-type)

send-simple-message
	(movem a (+ mailb2 1))
	(move b 0 b)
	(movem b jobn2)
	(movem b jobnum)
	(move b thisjob)
 	(hrl b epr)
	(movem b mailb2)
	(movem b mailbox)
     	(mail 5 jobn2)
	(jsp tt wait-for-clear)
	(jrst 0 true)
	(jrst 0 false)

wait-for-clear
	(setz a)
	(calli a 31)
	(jrst  0 -2 tt)

(entry em:send-control-char subr)
(args em:send-control-char (nil . 2))

send-control-char
	(movei t -1)		;count
	(move tt outchartem)
	(move a 0 a)		;get character
	(trne a 600)	 	;control and meta?
	(jrst 0 cm1)
	(trze a 200)		;control bit
	(pushj p c1)		;push control
	(trze a 400)		;meta bit
	(pushj p m1)		;push meta
cm2	(aos 0 charpos)
	(idpb a tt)
	(movei a ecommand-type)
	(hrli a short-bit)	;short control chars
	(movem a (+ mailb2 1))
	(hrlzm t (+ mailb2 2))
	(movei a outmail)
	(hrrm a (+ mailb2 2))

	(move b 0 b)
	(movem b jobn2)
	(movem b jobnum)
	(move b thisjob)
 	(hrl b epr)
	(movem b mailb2)
	(movem b mailbox)
     	(mail 5 jobn2)
	(jsp tt wait-for-clear)
	(jrst 0 true)
	(jrst 0 false)

c1	(movei r 2)		;alpha
	(aos 0 charpos)
	(idpb r tt)		;send it
	(sos 0 t)		;decrement
	(popj p)

m1	(movei r 3)		;beta
	(aos 0 charpos)
	(idpb r tt)		;send it
	(sos 0 t)		;decrement
	(popj p)

cm1	(movei r #o26)
	(aos 0 charpos)
	(idpb r tt)
	(sos 0 t)
	(trz r 600)
	(jrst 0 cm2)
(entry em:init subr)
(args em:init (nil . 0))

	(movei tt (+ noutbytes 1))
	(movem tt outbytes)
	(movei tt (+ nrovbytes 1))
	(movem tt rovbytes)
;	(setzm 0 mailinp)
	(setom 0 jobnum)
	(calli tt 30)
	(movem tt thisjob)
	(jrst 0 fix1)

transfer-short

	(move a inpointtem)	;byte pointer template
	(movem a inpoint)
	(pushj p zinmail)
	(hrlzi a (+ mailbox 3))	;move from here
	(hrri a inmail)		;to here
	(blt a (+ inmail 30.))	;transfer 30
	(setom 0 tyi-inited)	;ready to read
	(popj p)

send-ok
	(movei a ok-type)
	(movem a (+ mailb2 1))
	(move b thisjob)
 	(hrli b epr)
	(movem b mailb2)
     	(mail 5 jobn2)
	(jsp tt wait-for-clear)
	(jrst 0 true)
	(jrst 0 false)
(entry em:eval-protect subr)
(args em:eval-protect (nil . 0))
(movei a mailbox)
(movem a (special sail-mail-address))
(movei a 't)
(popj p)

(entry em:eval-unprotect subr)
(args em:eval-unprotect (nil . 0))
(movei a 'nil)
(movem a (special sail-mail-address))
(popj p)
;;; Routines for obtaining the values of readonly variables

(entry em:make-sixbit subr)
(args em:make-sixbit  (nil . 1))

;;; Takes list of variables and returns an alist of variable-value pairs
sixmak 	(movei b '6)				;direct lift from faslap
	(call 2 'pnget)
	(hlrz a 0 a)
	(move tt 0 a)
	(idpb tt rovpoint)	;put it there
	(sosle 0 rovbytes)	;ready to send?
	(jrst 0 fix1)		;return fixnum

;;; Read only variable mail message

(entry em:force-readonly-message subr)
(args em:force-readonly-message (nil . 0))

em:force-readonly-message
	(movei a outmail)	;address of buffer
	(movem a (+ mailbox 2))
	(move a rovbytes)	
	(movei a (+ nrovbytes 1))
	(sub a rovbytes)	
	(movei t 1)		;1 in t means long
	(caile a rovmaxshort)		;short enough
	(jrst 0 rovsend-message)	;nope
	(setz t)		;0 in T means short
	(hrlzi tt outmail)
	(hrri  tt (+ mailbox 3))
	(blt tt (+ mailbox (- mlblksize 1)))	;move to the right place
	(iori b short-bit)
rovsend-message
	(hrl tt b)		;swap
	(hrri tt readonlyvar-type)
	(movem tt (+ mailbox 1))
	(movns 0 a)
	(hrlzm a (+ mailbox 2))
	(movei a outmail)
	(hrrm a (+ mailbox 2))
	(move a thisjob)
 	(hrli a epr)		;epr validation
	(movem a mailbox)
	(mail 5 jobnum)		;mail it
	(jsp tt wait-for-clear)
	(skipa)
	(jrst 0 wrongj)
    	(hrlzi a outmail)	;zeros output buffer
	(hrri a (+ outmail 1))
	(setzm 0 outmail)
	(blt a (+ outmail (- rdblk 1)))	;zero it
	(skipe 0 (special sail-mail-interrupt))
	(jrst 0 rm1)
	(hrlzi a mailbox)	;zeros mailbox
	(hrri a (+ mailbox 1))	;unless interrupt caught some mail
	(setzm 0 mailbox)
	(blt a (+ mailbox (- mlblksize 1)))	;zero it
rm1	(move a rovpointtem)	;setup output byte count
	(movem a rovpoint)
	(movei a (+ nrovbytes 1))
	(setzm 0 rinbytes)
	(movem a rovbytes)
	(move a outpointtem)	;setup output byte pointer
	(movem a outpoint)
	(movei a (+ noutbytes 1))
	(movem a outbytes)
	(jumpe t true)		;don't hang around
	(pushj p wait-ok)	;wait for acknowledgment
	(pushj p em:mail-type)
	(came a 'ok)
	(jrst 0 false)
	(jrst 0 true)

(entry em:get-next-readonly subr)
(args em:get-next-readonly (nil . 0))

	(skipn 0 rinbytes)
	 (pushj p rovmail-refresh)
	(aosle 0 rinbytes)
	(jrst 0 rovdone)
	(ildb tt irovpoint)	;get it
	(jsp t fxcons)
	(push fxp a)		;save it
	(aosle  0 inbytes)
	(jrst 0 (- rovdone 1))
	(ildb tt irovpoint)
	(jsp t fxcons)
	(pop fxp b)
	(jcall 2 'xcons)

	(sub fxp (% 0 0 1 1))
rovdone (seto tt)
	(jrst 0 fix1)

rovmail-refresh
	(pushj p em:wait-mail)
	(jrst 0 em:process-mail)
;;; debugging routines

(entry em:inbytes subr)
	(move tt inbytes)
	(jrst 0 fix1)
;;; Storage for Mail routines

;firstyo (0)
svdacs (block 10.)
send-lines (0)
noncrlf (0)
vsend-lines (0)
skipp (0)
tyop (0)
forcedp (0)		;output already forced
inwords (0)		;number of words to input via jobread
explicit-eof (-1)	;nil
eofp (-1)		;-1 means mail in and not read
;mailinp (0)		;-1 means mail in and not read
mailint (4000000000)
jobnum	(0)
	(0 0 mailbox)

;(entry mailbox subr)

mailbox	(block mlblksize)	;mail
jobn2 (0)
	(0 0 mailb2)

;(entry mailb2 subr)

mailb2(block mlblksize)	;short mail

;(entry inmail subr)

inmail	(block blksize)	;text

;(entry outmail subr)

outmail	(block blksize)	;text
stack (block 20)
untyipdl (777760←22 0 stack)
temuntyipdl (777760←22 0 stack)
untyif (0)

;(entry inpoint subr)
;inpoint (700←22 0 (- inmail 1))
;inpointtem (700←22 0 (- inmail 1))

inpoint (1100←22 0 (- inmail 1))
inpointtem (1100←22 0 (- inmail 1))
irovpoint (4400←22 0 (- inmail 1))
irovpointtem (4400←22 0 (- inmail 1))
rinbytes (0)
inbytes (0)
outpoint (700←22 0 (- outmail 1))
outpointtem (700←22 0 (- outmail 1))
rovpoint (4400←22 0 (- outmail 1))
rovpointtem (4400←22 0 (- outmail 1))
outchartem (700←22 0 (+ mailb2 2))
outbytes (0 0 (% 0 0 (+ noutbytes 1)))
rovbytes (0 0 (% 0 0 (+ nrovbytes 1)))
mailprocessed (-1)	;0 means not processed
charpos (0)
tyi-inited (0)		;ready to read. 0 = nil, -1 = t
resume-pc  (0)		;where to get more chars
eofchar (0)		;eof char
thisjob (0)
jobread	(0)
	(0)
	(0 0 inmail)
()

(or (and (boundp 'em:no-init) em:no-init)
    (progn 
 	   (em:eval-protect)
	   (em:initialize) 
	   (princ '|MacLisp Ready|)))